Leaderboard

As some CAD users have heard the free 2D CAD program Draftsight, by Dassault Systemes, will cease functionality at the end of 2019. For those of you looking for a replacement I offer the following. All four programs are available in Windows, Linus and Mac versions. Note that both Draftsight and NanoCAD also offer very low cost versions of their CAD programs if one is so inclined. FreeCAD https://www.freecadweb.org/ Open source LibreCAD https://librecad.org/ Open source NanoCAD https://nanocad.com/ QCAD v3.23 https://qcad.org/en Open source

;;; drawpolyonsection ;;; http://www.theswamp.org/index.php?topic=45401.msg505671#msg505671 (defun c:drawpolyonsection (/ datumpts doc dtm grnd grndpts mspace pline prunedpts sctnvw) ;;select vla-object (defun vl-sel (msg / ent) (if (setq ent (car (entsel msg))) (vlax-ename->vla-object ent) ) ) ;;convert a C3D section object to a list of points from which a polyline ;; may be created (defun getpointlist (sctn sctnvw / links idx link start end ptlist x y) (setq links (vlax-get-property sctn 'links)) (setq idx -1) (while (< (setq idx (1+ idx)) (vlax-get links 'count)) (setq link (vlax-invoke links 'item idx)) (vlax-invoke-method sctnvw 'FindXYAtStationOffsetAndElevation 0 (vlax-get link 'startpointx) (vlax-get link 'startpointy) 'x 'y ) (setq start (cons x y)) (vlax-invoke-method sctnvw 'FindXYAtStationOffsetAndElevation 0 (vlax-get link 'endpointx) (vlax-get link 'endpointy) 'x 'y ) (setq end (cons x y) ) (if (= (vlax-get link 'type) 0) ;;this link is displayed (progn (if (not (member start ptlist)) (setq ptlist (cons start ptlist)) ) (if (not (member end ptlist)) (setq ptlist (cons end ptlist)) ) ) ) ) (setq ptlist (reverse ptlist)) ) (defun flattenlist (lst / result) (foreach l lst (setq result (cons (car l) result) result (cons (cdr l) result) ) ) result ) ;;selct the ground section, then the datum section, then the sectionview (setq grnd (vl-sel "\nSelect ground section: ") dtm (vl-sel "\nSelect datum section: ") sctnvw (vl-sel "\nSelect SectionView: ") ) ;;get the points, all start from left and go to the right (setq grndpts (getpointlist grnd sctnvw) datumpts (getpointlist dtm sctnvw) ) ;;use the points to construct pline. Omit the ground points outside the limits of the datum (setq prunedpts nil) (foreach pt grndpts (if (and (> (car pt) (caar datumpts)) (< (car pt) (car (last datumpts))) ) (setq prunedpts (cons pt prunedpts)) ) ) (setq doc (vla-get-activedocument (vlax-get-acad-object)) mspace (vla-get-modelspace doc) ) (setq pline (vlax-invoke mspace 'addlightweightpolyline (reverse (flattenlist (append datumpts prunedpts))) ) ) (vla-put-closed pline :vlax-true) (princ) ) ;;select vla-object (defun vl-sel (/ ent) (if (setq ent (car (entsel "\nSelect object: "))) (vlax-ename->vla-object ent) ) ) ;;convert a C3D section object to a list of points from which a polyline ;; may be created (defun getpointlist (sctn / links idx link start end ptlist) (setq links (vlax-get-property sctn 'links)) (setq idx -1) (while (< (setq idx (1+ idx)) (vlax-get links 'count)) (setq link (vlax-invoke links 'item idx) start (cons (vlax-get link 'startpointx) (vlax-get link 'startpointy)) end (cons (vlax-get link 'endpointx) (vlax-get link 'endpointy)) ) (if (not (member start ptlist)) (setq ptlist (cons start ptlist)) ) (if (not (member end ptlist)) (setq ptlist (cons end ptlist)) ) ) (setq ptlist (reverse ptlist)) ) ;;select the ground section, then the datum section (setq grnd (vl-sel) dtm (vl-sel) ) ;;get the points (setq grndpts (getpointlist grnd) datumpts (getpointlist dtm) )

Dont forget X & Y scale needed. There was a post about doing volumes automatically I think over at Forums/autodesk may be useful save some brain cells thinking about code. There is some manual ways copy all xsects block and rescale so 1:1 at true size ie metres etc, there is a break pline at point again I think it was forums/autodesk. Have to do something now will try later to find very simple 2 pick.

Attached auto cad file example

Here's one possible way: (defun c:toglay ( ) (vlax-for lay (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (foreach prp '(lock layeron freeze) (vl-catch-all-apply 'vlax-put (list lay prp (~ (vlax-get lay prp)))) ) ) (princ) ) (vl-load-com) (princ)

Test whether each set of three consecutive vertices follow a clockwise or anticlockwise path. For example: (defun convex-p ( lst ) (apply '= (mapcar 'LM:clockwise-p lst (cdr lst) (cddr lst))) ) ;; Clockwise-p - Lee Mac ;; Returns T if p1,p2,p3 are clockwise oriented (defun LM:Clockwise-p ( p1 p2 p3 ) (< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1))) ) ) Test program: (defun c:test ( / lst sel ) (if (setq sel (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))) (progn (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget (ssname sel 0))))) (convex-p (cons (last lst) lst)) ) ) )

This routine will allows to switch current state of above noted layers: (defun c:1( / LayerFeatures LayerState ) (foreach LayerItem '("frame-rails" "frame-endcaps") (setq LayerFeatures (entget (tblobjname "LAYER" LayerItem)) ;list layer's properties LayerState (cdr (assoc 62 LayerFeatures))) ;get current state (on/off) (entmod (subst (cons '62 (* -1 LayerState)) ;switch state (assoc 62 LayerFeatures) LayerFeatures)) ) (princ) ) Regards,

I can't find where I got this from, AND it doesn't work across layouts for some reason, but just a start: (defun C:Remove_Fields ( / del-field ss1 index item) (vl-load-com) (defun del-field (ent / edic elist etype obj val) (if (and (setq edic (cdr (assoc 360 (setq elist (entget ent))))) (dictsearch edic "ACAD_FIELD") ) (progn (setq obj (vlax-ename->vla-object ent) etype (cdr (assoc 0 elist)) ) (cond ((= etype "DIMENSION") (setq val (vla-get-textoverride obj)) (dictremove edic "ACAD_FIELD") (vla-put-textoverride obj val) ) ((= etype "MTEXT") (setq val (vla-get-textstring obj)) (dictremove edic "ACAD_FIELD") (vla-put-textstring obj val) ) (T (dictremove edic "ACAD_FIELD")) ) ) ) ) (if (setq ss1 (ssget "X" (list (cons 0 "TEXT,MTEXT,MULTILEADER,DIMENSION") (cons 67 1) ) ) ) (progn (setq index 0) (repeat (sslength ss1) (setq item (ssname ss1 index)) (if (del-field item) (entupd item)) (setq index (+ 1 index)) ) ) ) (if (setq ss1 (ssget "X" (list (cons 0 "INSERT") (cons 67 1) (cons 66 1) ) ) ) (progn (setq index 0) (repeat (sslength ss1) (setq item (ssname ss1 index)) (while (= (cdr (assoc 0 (entget (setq item (entnext item))))) "ATTRIB") (if (del-field item) (entupd item)) ) (setq index (+ 1 index)) ) ) ) (princ) )