;;; =========================================================================== ;;; Routine Name: DIVCURVES (DCL UI Version - Fully Toggled & Sanitized) ;;; Logic & Concept: Mostafa Jalal ;;; =========================================================================== (vl-load-com) ;; ============================ ;; DIALOG UI GENERATOR ;; ============================ (defun get-def (key def / val) (setq val (getenv (strcat "DIV_" key))) (if (or (null val) (= val "")) def val) ) (defun show-divcurves-dialog ( / dcl-id dcl-file f res allowedList lastDist lastDistLine lastNumSlices lastScPieces c_acts l_acts circ_acts sa_acts sl_acts sc_acts) ;; Retrieve values for text fields and sanitize old text ghosts (setq lastDist (get-def "Dist" "0.50")) (if (not (distof lastDist)) (setq lastDist "0.50")) (setq lastDistLine (get-def "DistLine" "1.00")) (if (not (distof lastDistLine)) (setq lastDistLine "1.00")) (setq lastNumSlices (get-def "NumSlices" "4")) (setq lastScPieces (get-def "ShortCircPieces" "4")) ;; Create DCL File (setq dcl-file (vl-filename-mktemp "divcurves.dcl")) (setq f (open dcl-file "w")) (write-line "divcurves_dlg : dialog { label = \"DIVCURVES - Division Settings\";" f) (write-line " : row {" f) (write-line " : boxed_column { label = \"Target Objects\";" f) (write-line " : toggle { key = \"t_pl\"; label = \"Polylines (2D/3D)\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_ln\"; label = \"Lines\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_arc\"; label = \"Arcs\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_cir\"; label = \"Circles\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_spl\"; label = \"Splines\"; value = \"1\"; }" f) (write-line " : toggle { key = \"t_fl\"; label = \"Feature Lines\"; value = \"1\"; }" f) (write-line " : row {" f) (write-line " : button { key = \"btn_all_ents\"; label = \"Select All\"; }" f) (write-line " : button { key = \"btn_no_ents\"; label = \"Deselect All\"; }" f) (write-line " }" f) (write-line " }" f) (write-line " : column {" f) (write-line " : boxed_column { label = \"Curve Division\";" f) (write-line " : row { " f) (write-line " : toggle { key = \"tg_c_dist\"; label = \"Distance\"; }" f) (write-line " : toggle { key = \"tg_c_mid\"; label = \"Middle\"; }" f) (write-line " : toggle { key = \"tg_c_skip\"; label = \"Skip\"; }" f) (write-line " }" f) (write-line " : edit_box { key = \"eb_cdist\"; label = \"Value:\"; edit_width = 8; }" f) (write-line " }" f) (write-line " : boxed_column { label = \"Line Division\";" f) (write-line " : row { " f) (write-line " : toggle { key = \"tg_l_dist\"; label = \"Distance\"; }" f) (write-line " : toggle { key = \"tg_l_mid\"; label = \"Middle\"; }" f) (write-line " : toggle { key = \"tg_l_vert\"; label = \"Vertices\"; }" f) (write-line " : toggle { key = \"tg_l_skip\"; label = \"Skip\"; }" f) (write-line " }" f) (write-line " : edit_box { key = \"eb_ldist\"; label = \"Value:\"; edit_width = 8; }" f) (write-line " }" f) (write-line " : boxed_column { label = \"Standard Circle Settings\";" f) (write-line " : row { " f) (write-line " : toggle { key = \"tg_circ_dist\"; label = \"Distance\"; }" f) (write-line " : toggle { key = \"tg_circ_pcs\"; label = \"Pieces\"; }" f) (write-line " }" f) (write-line " : edit_box { key = \"eb_slices\"; label = \"Pieces:\"; edit_width = 8; }" f) (write-line " }" f) (write-line " }" f) (write-line " : column {" f) (write-line " : boxed_column { label = \"Short Arc\";" f) (write-line " : row { " f) (write-line " : toggle { key = \"tg_sa_mid\"; label = \"Middle\"; }" f) (write-line " : toggle { key = \"tg_sa_vert\"; label = \"Vertices\"; }" f) (write-line " : toggle { key = \"tg_sa_skip\"; label = \"Skip\"; }" f) (write-line " }" f) (write-line " }" f) (write-line " : boxed_column { label = \"Short Line\";" f) (write-line " : row { " f) (write-line " : toggle { key = \"tg_sl_mid\"; label = \"Middle\"; }" f) (write-line " : toggle { key = \"tg_sl_vert\"; label = \"Vertices\"; }" f) (write-line " : toggle { key = \"tg_sl_skip\"; label = \"Skip\"; }" f) (write-line " }" f) (write-line " }" f) (write-line " : boxed_column { label = \"Short Circle\";" f) (write-line " : row { " f) (write-line " : toggle { key = \"tg_sc_mid\"; label = \"Middle\"; }" f) (write-line " : toggle { key = \"tg_sc_pcs\"; label = \"Pieces\"; }" f) (write-line " : toggle { key = \"tg_sc_skip\"; label = \"Skip\"; }" f) (write-line " }" f) (write-line " : edit_box { key = \"eb_scirc_pc\"; label = \"Pieces:\"; edit_width = 8; }" f) (write-line " }" f) (write-line " }" f) (write-line " }" f) (write-line " ok_cancel;" f) (write-line "}" f) (close f) (setq dcl-id (load_dialog dcl-file)) (if (not (new_dialog "divcurves_dlg" dcl-id)) (exit)) ;; Apply Initial Toggle States from Memory (set_tile "tg_c_dist" (get-def "tg_c_dist" "1")) (set_tile "tg_c_mid" (get-def "tg_c_mid" "0")) (set_tile "tg_c_skip" (get-def "tg_c_skip" "0")) (set_tile "tg_l_dist" (get-def "tg_l_dist" "1")) (set_tile "tg_l_mid" (get-def "tg_l_mid" "0")) (set_tile "tg_l_vert" (get-def "tg_l_vert" "0")) (set_tile "tg_l_skip" (get-def "tg_l_skip" "0")) (set_tile "tg_circ_dist" (get-def "tg_circ_dist" "1")) (set_tile "tg_circ_pcs" (get-def "tg_circ_pcs" "0")) (set_tile "tg_sa_mid" (get-def "tg_sa_mid" "1")) (set_tile "tg_sa_vert" (get-def "tg_sa_vert" "0")) (set_tile "tg_sa_skip" (get-def "tg_sa_skip" "0")) (set_tile "tg_sl_mid" (get-def "tg_sl_mid" "0")) (set_tile "tg_sl_vert" (get-def "tg_sl_vert" "1")) (set_tile "tg_sl_skip" (get-def "tg_sl_skip" "0")) (set_tile "tg_sc_mid" (get-def "tg_sc_mid" "1")) (set_tile "tg_sc_pcs" (get-def "tg_sc_pcs" "0")) (set_tile "tg_sc_skip" (get-def "tg_sc_skip" "0")) ;; Set Text Box Values (set_tile "eb_cdist" lastDist) (set_tile "eb_ldist" lastDistLine) (set_tile "eb_slices" lastNumSlices) (set_tile "eb_scirc_pc" lastScPieces) ;; Enable/Disable input boxes initially based on Distance/Pieces ticks (mode_tile "eb_cdist" (if (= (get_tile "tg_c_dist") "1") 0 1)) (mode_tile "eb_ldist" (if (= (get_tile "tg_l_dist") "1") 0 1)) (mode_tile "eb_slices" (if (= (get_tile "tg_circ_pcs") "1") 0 1)) (mode_tile "eb_scirc_pc" (if (= (get_tile "tg_sc_pcs") "1") 0 1)) ;; UI Interactions (Checking "Skip" clears other ticks. Unchecking Dist/Pieces disables text box) (action_tile "tg_c_dist" "(if (= $value \"1\") (set_tile \"tg_c_skip\" \"0\")) (mode_tile \"eb_cdist\" (if (= $value \"1\") 0 1))") (action_tile "tg_c_mid" "(if (= $value \"1\") (set_tile \"tg_c_skip\" \"0\"))") (action_tile "tg_c_skip" "(if (= $value \"1\") (progn (set_tile \"tg_c_dist\" \"0\") (set_tile \"tg_c_mid\" \"0\") (mode_tile \"eb_cdist\" 1)))") (action_tile "tg_l_dist" "(if (= $value \"1\") (set_tile \"tg_l_skip\" \"0\")) (mode_tile \"eb_ldist\" (if (= $value \"1\") 0 1))") (action_tile "tg_l_mid" "(if (= $value \"1\") (set_tile \"tg_l_skip\" \"0\"))") (action_tile "tg_l_vert" "(if (= $value \"1\") (set_tile \"tg_l_skip\" \"0\"))") (action_tile "tg_l_skip" "(if (= $value \"1\") (progn (set_tile \"tg_l_dist\" \"0\") (set_tile \"tg_l_mid\" \"0\") (set_tile \"tg_l_vert\" \"0\") (mode_tile \"eb_ldist\" 1)))") (action_tile "tg_circ_dist" "") (action_tile "tg_circ_pcs" "(mode_tile \"eb_slices\" (if (= $value \"1\") 0 1))") (action_tile "tg_sa_mid" "(if (= $value \"1\") (set_tile \"tg_sa_skip\" \"0\"))") (action_tile "tg_sa_vert" "(if (= $value \"1\") (set_tile \"tg_sa_skip\" \"0\"))") (action_tile "tg_sa_skip" "(if (= $value \"1\") (progn (set_tile \"tg_sa_mid\" \"0\") (set_tile \"tg_sa_vert\" \"0\")))") (action_tile "tg_sl_mid" "(if (= $value \"1\") (set_tile \"tg_sl_skip\" \"0\"))") (action_tile "tg_sl_vert" "(if (= $value \"1\") (set_tile \"tg_sl_skip\" \"0\"))") (action_tile "tg_sl_skip" "(if (= $value \"1\") (progn (set_tile \"tg_sl_mid\" \"0\") (set_tile \"tg_sl_vert\" \"0\")))") (action_tile "tg_sc_mid" "(if (= $value \"1\") (set_tile \"tg_sc_skip\" \"0\"))") (action_tile "tg_sc_pcs" "(if (= $value \"1\") (set_tile \"tg_sc_skip\" \"0\")) (mode_tile \"eb_scirc_pc\" (if (= $value \"1\") 0 1))") (action_tile "tg_sc_skip" "(if (= $value \"1\") (progn (set_tile \"tg_sc_mid\" \"0\") (set_tile \"tg_sc_pcs\" \"0\") (mode_tile \"eb_scirc_pc\" 1)))") ;; Target Objects Buttons (action_tile "btn_all_ents" "(foreach k '(\"t_pl\" \"t_ln\" \"t_arc\" \"t_cir\" \"t_spl\" \"t_fl\") (set_tile k \"1\"))") (action_tile "btn_no_ents" "(foreach k '(\"t_pl\" \"t_ln\" \"t_arc\" \"t_cir\" \"t_spl\" \"t_fl\") (set_tile k \"0\"))") ;; Dialog Actions (action_tile "accept" (strcat "(setq pl_val (get_tile \"t_pl\") ln_val (get_tile \"t_ln\") arc_val (get_tile \"t_arc\") " "cir_val (get_tile \"t_cir\") spl_val (get_tile \"t_spl\") fl_val (get_tile \"t_fl\") " "v_c_dist (get_tile \"tg_c_dist\") v_c_mid (get_tile \"tg_c_mid\") v_c_skip (get_tile \"tg_c_skip\") " "v_l_dist (get_tile \"tg_l_dist\") v_l_mid (get_tile \"tg_l_mid\") v_l_vert (get_tile \"tg_l_vert\") v_l_skip (get_tile \"tg_l_skip\") " "v_circ_dist (get_tile \"tg_circ_dist\") v_circ_pcs (get_tile \"tg_circ_pcs\") " "v_sa_mid (get_tile \"tg_sa_mid\") v_sa_vert (get_tile \"tg_sa_vert\") v_sa_skip (get_tile \"tg_sa_skip\") " "v_sl_mid (get_tile \"tg_sl_mid\") v_sl_vert (get_tile \"tg_sl_vert\") v_sl_skip (get_tile \"tg_sl_skip\") " "v_sc_mid (get_tile \"tg_sc_mid\") v_sc_pcs (get_tile \"tg_sc_pcs\") v_sc_skip (get_tile \"tg_sc_skip\") " "c_dist_val (get_tile \"eb_cdist\") " "l_dist_val (get_tile \"eb_ldist\") " "circ_slices (get_tile \"eb_slices\") " "scirc_slices (get_tile \"eb_scirc_pc\") " ") (done_dialog 1)" ) ) (action_tile "cancel" "(done_dialog 0)") (setq res (start_dialog)) (unload_dialog dcl-id) (vl-file-delete dcl-file) ;; Process UI Results (if (= res 1) (progn ;; Build Action Lists (Strings to execute) (setq c_acts '()) (if (= v_c_dist "1") (setq c_acts (cons "Distance" c_acts))) (if (= v_c_mid "1") (setq c_acts (cons "Middle" c_acts))) (if (= v_c_skip "1") (setq c_acts '())) (setq l_acts '()) (if (= v_l_dist "1") (setq l_acts (cons "Distance" l_acts))) (if (= v_l_vert "1") (setq l_acts (cons "Vertices" l_acts))) (if (= v_l_mid "1") (setq l_acts (cons "Middle" l_acts))) (if (= v_l_skip "1") (setq l_acts '())) (setq circ_acts '()) (if (= v_circ_pcs "1") (setq circ_acts (cons "Pieces" circ_acts))) (if (= v_circ_dist "1") (setq circ_acts (cons "Distance" circ_acts))) (setq sa_acts '()) (if (= v_sa_vert "1") (setq sa_acts (cons "Vertices" sa_acts))) (if (= v_sa_mid "1") (setq sa_acts (cons "Middle" sa_acts))) (if (= v_sa_skip "1") (setq sa_acts '())) (setq sl_acts '()) (if (= v_sl_vert "1") (setq sl_acts (cons "Vertices" sl_acts))) (if (= v_sl_mid "1") (setq sl_acts (cons "Middle" sl_acts))) (if (= v_sl_skip "1") (setq sl_acts '())) (setq sc_acts '()) (if (= v_sc_pcs "1") (setq sc_acts (cons "Pieces" sc_acts))) (if (= v_sc_mid "1") (setq sc_acts (cons "Middle" sc_acts))) (if (= v_sc_skip "1") (setq sc_acts '())) ;; Build Allowed Objects (setq allowedList (append (if (= pl_val "1") '("*POLYLINE") '()) (if (= ln_val "1") '("LINE") '()) (if (= arc_val "1") '("ARC") '()) (if (= cir_val "1") '("CIRCLE") '()) (if (= spl_val "1") '("SPLINE") '()) (if (= fl_val "1") '("AECC_FEATURE_LINE") '()) )) ;; Save Memory Defaults (setenv "DIV_tg_c_dist" v_c_dist) (setenv "DIV_tg_c_mid" v_c_mid) (setenv "DIV_tg_c_skip" v_c_skip) (setenv "DIV_tg_l_dist" v_l_dist) (setenv "DIV_tg_l_mid" v_l_mid) (setenv "DIV_tg_l_vert" v_l_vert) (setenv "DIV_tg_l_skip" v_l_skip) (setenv "DIV_tg_circ_dist" v_circ_dist) (setenv "DIV_tg_circ_pcs" v_circ_pcs) (setenv "DIV_tg_sa_mid" v_sa_mid) (setenv "DIV_tg_sa_vert" v_sa_vert) (setenv "DIV_tg_sa_skip" v_sa_skip) (setenv "DIV_tg_sl_mid" v_sl_mid) (setenv "DIV_tg_sl_vert" v_sl_vert) (setenv "DIV_tg_sl_skip" v_sl_skip) (setenv "DIV_tg_sc_mid" v_sc_mid) (setenv "DIV_tg_sc_pcs" v_sc_pcs) (setenv "DIV_tg_sc_skip" v_sc_skip) (setenv "DIV_Dist" c_dist_val) (setenv "DIV_DistLine" l_dist_val) (setenv "DIV_NumSlices" circ_slices) (setenv "DIV_ShortCircPieces" scirc_slices) ;; Return Structured Data (list allowedList ; 0: Allowed entity types c_acts ; 1: Curve Acts (distof c_dist_val) ; 2: Curve Dist l_acts ; 3: Line Acts (distof l_dist_val) ; 4: Line Dist circ_acts ; 5: Circle Acts (atoi circ_slices) ; 6: Circle Pieces sa_acts ; 7: Short Arc Acts sl_acts ; 8: Short Line Acts sc_acts ; 9: Short Circle Acts (atoi scirc_slices) ; 10: Short Circle Pieces ) ) nil ) ) ;; =========================================================================== ;; MAIN COMMAND ;; =========================================================================== (defun c:DIVCURVES (/ ui-data ss i ent obj endParam pIdx segmentLen entType totalLen allowedTypes filter typeStr c_acts c_dist l_acts l_dist circ_acts circ_pcs sa_acts sl_acts sc_acts sc_pcs p-list startPt endPt chordLen isCurveSegment midPt chordMid sagTol distVal isShort activeActs pcs) ;; --- 1. CALL UI DIALOG --- (setq ui-data (show-divcurves-dialog)) (if (null ui-data) (progn (princ "\nCommand cancelled.") (exit))) ;; Extract UI Variables (setq allowedTypes (nth 0 ui-data) c_acts (nth 1 ui-data) c_dist (nth 2 ui-data) l_acts (nth 3 ui-data) l_dist (nth 4 ui-data) circ_acts (nth 5 ui-data) circ_pcs (nth 6 ui-data) sa_acts (nth 7 ui-data) sl_acts (nth 8 ui-data) sc_acts (nth 9 ui-data) sc_pcs (nth 10 ui-data)) (if (or (null allowedTypes) (= (length allowedTypes) 0)) (progn (alert "No entity types selected!") (exit)) ) ;; --- 2. SET SELECTION FILTER --- (setq typeStr (car allowedTypes)) (foreach st (cdr allowedTypes) (setq typeStr (strcat typeStr "," st))) (setq filter (list (cons 0 typeStr))) (princ "\nSelect objects: ") (setq ss (ssget filter)) ;; --- 3. PROCESSING --- (if ss (progn (setq i 0) (repeat (sslength ss) (setq ent (ssname ss i) entType (cdr (assoc 0 (entget ent))) obj (if (= entType "AECC_FEATURE_LINE") ent (vlax-ename->vla-object ent)) endParam (vlax-curve-getEndParam obj) totalLen (vlax-curve-getDistAtParam obj endParam) p-list nil) (cond ;; ========================================================= ;; MULTI-SEGMENT: Polylines and Feature Lines ;; ========================================================= ((or (wcmatch entType "*POLYLINE*") (= entType "AECC_FEATURE_LINE")) (setq pIdx 0) (while (< pIdx endParam) (setq startPt (vlax-curve-getPointAtParam obj pIdx)) (setq endPt (vlax-curve-getPointAtParam obj (1+ pIdx))) (setq segmentLen (- (vlax-curve-getDistAtParam obj (1+ pIdx)) (vlax-curve-getDistAtParam obj pIdx))) (setq chordLen (distance startPt endPt)) ;; Midpoint-sag test for curve vs straight segment detection (setq midPt (vlax-curve-getPointAtParam obj (+ pIdx 0.5))) (setq chordMid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) startPt endPt)) (setq sagTol (max 1e-3 (* 1e-4 chordLen))) (setq isCurveSegment (> (distance midPt chordMid) sagTol)) ;; AECC_FEATURE_LINE approximation override (if (and isCurveSegment (= entType "AECC_FEATURE_LINE")) (setq segmentLen (+ (distance startPt midPt) (distance midPt endPt)))) ;; Determine standard actions for this segment type (setq activeActs (if isCurveSegment c_acts l_acts)) (setq distVal (if isCurveSegment c_dist l_dist)) ;; Short Segment Override Logic (setq isShort (and (member "Distance" activeActs) (< segmentLen distVal))) (if isShort (setq activeActs (if isCurveSegment sa_acts sl_acts)) ) ;; Execute Ticked Actions (if activeActs (progn (DIV:SafeMark obj startPt) (DIV:SafeMark obj endPt) (foreach act activeActs (cond ((= act "Middle") (process-segment-fixed obj pIdx segmentLen "Middle")) ((= act "Distance") (process-segment-fixed obj pIdx segmentLen distVal)) ((= act "Vertices") nil) ;; Vertices already marked ) ) ) ) (setq pIdx (1+ pIdx)))) ;; ========================================================= ;; STANDALONE: Splines, Lines, Arcs, Circles ;; ========================================================= (t ;; Determine standard actions (setq activeActs (cond ((= entType "CIRCLE") circ_acts) ((= entType "LINE") l_acts) (t c_acts))) (setq distVal (if (= entType "LINE") l_dist c_dist)) ;; Short Segment Override Logic (Only applies if "Distance" is ticked and length fails) (setq isShort (and (member "Distance" activeActs) (< totalLen distVal))) (if isShort (setq activeActs (cond ((= entType "CIRCLE") sc_acts) ((= entType "LINE") sl_acts) ((= entType "ARC") sa_acts) (t activeActs))) ) ;; Execute Ticked Actions (if activeActs (progn (DIV:SafeMark obj (vlax-curve-getStartPoint obj)) (if (not (vlax-curve-isClosed obj)) (DIV:SafeMark obj (vlax-curve-getEndPoint obj))) (foreach act activeActs (cond ((= act "Middle") (process-standalone-fixed obj totalLen "Middle" 0 0 "")) ((= act "Distance") (process-standalone-fixed obj totalLen distVal 0 0 "")) ((= act "Vertices") nil) ((= act "Pieces") (setq pcs (if isShort sc_pcs circ_pcs)) (process-standalone-fixed obj totalLen 0 0 pcs "Pieces")) ) ) ) ) ) ) (setq i (1+ i))) (princ (strcat "\nProcessed " (itoa (sslength ss)) " objects.")))) (princ) ) ;; ====================== HELPER FUNCTIONS ====================== (defun DIV:SafeMark (obj pt / checkPt) (if (and pt (listp pt)) (progn (setq checkPt (vlax-curve-getClosestPointTo obj pt)) (if (and (equal pt checkPt 1e-4) (not (vl-some '(lambda (x) (equal pt x 1e-3)) p-list))) (progn (entmake (list '(0 . "POINT") (cons 10 pt))) (setq p-list (cons pt p-list))))))) (defun process-segment-fixed (obj pIdx segmentLen tempDist / k divDist) (cond ((= tempDist "Vertices") nil) ((= tempDist "Middle") (DIV:SafeMark obj (vlax-curve-getPointAtParam obj (+ pIdx 0.5)))) ((and (numberp tempDist) (> tempDist 0)) (if (> tempDist segmentLen) (DIV:SafeMark obj (vlax-curve-getPointAtParam obj (+ pIdx 0.5))) (progn (setq k 1) (while (< (* k tempDist) (- segmentLen 0.001)) (setq divDist (+ (vlax-curve-getDistAtParam obj pIdx) (* k tempDist))) (DIV:SafeMark obj (vlax-curve-getPointAtDist obj divDist)) (setq k (1+ k)))))))) (defun process-standalone-fixed (obj totalLen tempDist offset numSlices circleMode / k) (cond ((= tempDist "Vertices") nil) ((= tempDist "Middle") (DIV:SafeMark obj (vlax-curve-getPointAtDist obj (+ offset (* totalLen 0.5))))) ((and (= circleMode "Pieces") (numberp numSlices) (> numSlices 1)) (setq k 1) (repeat (1- numSlices) (DIV:SafeMark obj (vlax-curve-getPointAtDist obj (* k (/ totalLen (float numSlices))))) (setq k (1+ k)))) ((and (numberp tempDist) (> tempDist 0)) (if (> tempDist totalLen) (DIV:SafeMark obj (vlax-curve-getPointAtDist obj (+ offset (* totalLen 0.5)))) (progn (setq k 1) (while (< (* k tempDist) (- totalLen 0.001)) (DIV:SafeMark obj (vlax-curve-getPointAtDist obj (+ offset (* k tempDist)))) (setq k (1+ k))))))))