Community
Civil 3D Customization
Welcome to Autodesk’s AutoCAD Civil 3D Forums. Share your knowledge, ask questions, and explore popular AutoCAD Civil 3D Customization topics.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

creating points from the addlabel of the contours at the element

0 REPLIES 0
Reply
Message 1 of 1
hosneyalaa
254 Views, 0 Replies

creating points from the addlabel of the contours at the element

التقاط.PNG

 

 

(defun c:test_pp ( / ) ;algn srf ststa endsta csta incr off x y xy pt

    (vl-load-com)

  (IF (OR
	(setq algn (vlax-ename->vla-object (setq obent(car (entsel "\nSelect Polyline: ")))))
        (while (not (= (vlax-get-property algn 'ObjectName) "AcDbPolyline"))
         (setq algn (vlax-ename->vla-object (car (entsel "\nSelect Polyline: "))))
       )
	     )

    
	(PROGN
   ;; Jeff Mishler
  (setq *acad* (vlax-get-acad-object))
  (setq C3D (strcat "HKEY_LOCAL_MACHINE\\"
                    (if vlax-user-product-key
                      (vlax-user-product-key)
                      (vlax-product-key)
                    )
            )
        C3D (vl-registry-read C3D "Release")
        C3D (substr
              C3D
              1
              (vl-string-search "." C3D (+ (vl-string-search "." C3D) 1))
            )
        C3D (vla-getinterfaceobject
              *acad*
              (strcat "AeccXUiLand.AeccApplication." C3D)
            )
  )

  
  (setq C3Ddoc (vla-get-activedocument C3D))
  (setq pnts (vlax-get C3Ddoc 'points))

  
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq blksObj (vla-get-blocks doc))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (setq spc (vla-get-modelspace doc))

  


         (setq srf (vlax-ename->vla-object (setq ent (car (entsel "\nSelect Surface: ")))))
	(while (not (= (vlax-get-property srf 'ObjectName) "AeccDbSurfaceTin"))
		(setq srf (vlax-ename->vla-object (car (entsel "\nEntity must be C3D Surface. Try again: "))))
		)
(sssetfirst nil (ssadd ent))

(Command "_AeccAddContourLabeling" "o" "no" obent "")
            (setq entlbb (entlast))
(command "explode" entlbb)
(setq entlbbx (entlast))

    (setq obj (vlax-ename->vla-object entlbbx))
     (setq ename (GetLevel (vla-get-name obj) blksObj))
     (mapcar 'cadr ename)
      (mapcar 'car ename)

(setq enameXYZ (mapcar '(lambda(x Y)(LIST (CAR X) (CADR X) Y)) (mapcar 'cadr ename)(mapcar 'car ename) ))



                       (setq idx -1)

                         
		       (while (setq ename (nth (setq idx (1+ idx)) enameXYZ ))
		       (setq oCogo(vlax-invoke pnts 'add ename))
		       (setq pntnums (vlax-get oCogo 'number))
	                (vla-put-NAME oCogo (strcat "EXPLODE CIVIL POINT & " (itoa pntnums)));NAME   NETWORK;NAME   NETWORK
	              (vla-put-description oCogo "CONVERT");  NAME MANHOLE
	              (vlax-put-property oCogo 'Style (strcat "Benchmark"))
	              (vlax-put-property oCogo 'LabelStyle "Elevation Only")

			 
		       );;;(while

      )
    )
		  (princ)
	)




;;https://www.cadtutor.net/forum/topic/70589-if-possible-help-with-a-small-change/?tab=comments#comment-566525
 ;; Roy_043
(defun GetLevel (nme blksObj / out)
  (vlax-for obj (vla-item blksObj nme)
    (cond
;;;      (out)
;;;      ((/= "V-NODE-TEXT" (strcase (vla-get-layer obj)))
;;;        nil
;;;      )
      ((= "AcDbBlockReference" (vla-get-objectname obj))
        (setq out (GetLevel (vla-get-name obj) blksObj))
      )
      ((not (vlax-property-available-p obj 'textstring))
        nil
      )
      ((wcmatch (vla-get-textstring obj) "*#.#*")
        (setq out (cons (list (last (LM:parsenumbers (vla-get-textstring obj)))(vlax-get obj 'insertionpoint)) out))
      )
    )
  )
)



  ;; Parse Numbers  -  Lee Mac
;; Parses a list of numerical values from a supplied string.

        (defun LM:parsenumbers ( str )
    (   (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (mapcar
                           '(lambda ( a b c )
                                (if (or (< 47 b 58)
                                        (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                        (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                    )
                                    b 32
                                )
                            )
                            (cons nil l) l (append (cdr l) '(()))
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list str)
    )
)
0 REPLIES 0

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Rail Community


 

Autodesk Design & Make Report